home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 2 / Mac Magazin and MacEasy Magazine CD - Issue 02.iso / Themen Mac Magazin / Multimedia / Grafik-&QT Tools / NIH Image 1.53 (non-fpu) / Macros / Demo Macro < prev    next >
Text File  |  1993-11-02  |  6KB  |  340 lines
  1. procedure AdvanceRoi;
  2. begin
  3.   hloc:=hloc+RoiWidth;
  4.   if (hloc+RoiWidth div 2)>PicWidth then begin
  5.     hloc:=0;
  6.     vloc:=vloc+RoiHeight;
  7.   end;
  8.   if (hloc+RoiWidth)>PicWidth then hloc:=PicWidth-RoiWidth;
  9.   if (vloc+RoiHeight)>PicHeight then vloc:=PicHeight-RoiHeight;
  10.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  11. end;
  12.  
  13.  
  14. procedure MakeBlocks(n:integer);
  15. var
  16.   i,hloc,vloc,PicWidth,PicHeight:integer;
  17.   RoiWidth,RoiHeight:integer;
  18.   scale:real;
  19. begin
  20.   GetPicSize(PicWidth,PicHeight);
  21.   scale:=1/n;
  22.   SelectAll;
  23.   SetScaling('Nearest Neighbor; Same Window');
  24.   ScaleAndRotate(scale,scale,0);
  25.   RestoreRoi;
  26.   GetRoi(hloc,vloc,RoiWidth,RoiHeight);
  27.   copy;
  28.   SelectAll;
  29.   Clear;
  30.   hloc:=0;
  31.   vloc:=0;
  32.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  33.   for i:=1 to n*n do begin
  34.     Paste;
  35.     AdvanceRoi;
  36.   end;
  37.   KillRoi;
  38. end;
  39.  
  40.  
  41. procedure DoTextDemo;
  42. begin
  43.   RevertToSaved;
  44.   MoveTo(100,20);
  45.   SetForegroundColor(255);
  46.   SetBackgroundColor(0);
  47.   SetFont('Geneva');
  48.   SetFontSize(24);
  49.   SetText('No background, Bold, Center');
  50.   Writeln('Text');
  51.   SetText('With background');
  52.   Writeln('With Background');
  53.   SetText('Bold');
  54.   Writeln('Bold');
  55.   SetText('Underlined');
  56.   Writeln('Underlined');
  57.   SetText('Italic');
  58.   Writeln('Italics');
  59.   SetText('Outline');
  60.   Writeln('Outlined');
  61.   SetText('Shadow');
  62.   Writeln('Shadowed');
  63.   SetText('Plain');
  64.   SetFontSize(9);
  65.   MoveTo(100,240);
  66.   Writeln('Very small');
  67.   wait(.5);
  68.   SetFontSize(24);
  69.   MoveTo(100,240);
  70.   Writeln('Small');
  71.   wait(.5);
  72.   SetFontSize(48);
  73.   MoveTo(100,240);
  74.   SetText('Bold');
  75.   Writeln('MEDIAN');
  76.   wait(.5);
  77.   SetFontSize(96);
  78.   MoveTo(100,240);
  79.   Writeln('LARGE');
  80.   wait(1);
  81. end;
  82.  
  83.  
  84. procedure DrawGrayLevelScale(nBoxes:integer);
  85. var
  86.   PicWidth, PicHeight,i,GrayLevel,hloc,vloc,width,height,vdelta:integer;
  87. begin
  88.   GetPicSize(PicWidth,PicHeight);
  89.   SetFont('Helvetica');
  90.   SetFontSize(9);
  91.   SetText('Bold; Center; with background');
  92.   SetBackgroundColor(0);
  93.   width:=0.9*PicHeight/nBoxes;
  94.   height:=width;
  95.   hloc:=0.05*PicHeight;
  96.   vloc:=hloc;
  97.   vdelta:=height-1;
  98.   GrayLevel:=0;
  99.   for i:=1 to nBoxes do begin
  100.     MakeRoi(hloc,vloc,width,height);
  101.     SetForeground(GrayLevel);
  102.     Fill;
  103.     SetForeground(255);
  104.     DrawBoundary;
  105.     MoveTo(hloc+width/2,vloc+height/2);
  106.     Writeln(GrayLevel);
  107.     GrayLevel:=GrayLevel+trunc(256/nBoxes);
  108.     vloc:=vloc+vdelta;
  109.   end;
  110. end;
  111.  
  112.  
  113. procedure DrawColorScale;
  114. var
  115.   top,left,width,height,nLabels,i,tvloc:integer;
  116. begin
  117.   nLabels:=16;
  118.   SetFontSize(12);
  119.   SetFont('Helvetica');
  120.   SetText('Right Justified');
  121.   DrawScale;
  122.   GetRoi(left,top,width,height);
  123.   KillRoi;
  124.   SetForeground(255); {black}
  125.   SetBackground(0); {255}
  126.   vloc:=top;
  127.   for i:=1 to nLabels do begin
  128.     MoveTo(left+width+25,vloc+3);
  129.     tvloc:=vloc;
  130.     if tvloc>(top+height-1) then tvloc:=Top+height-1;
  131.     Writeln(GetPixel(left,tvloc));
  132.     vloc:=vloc+round(height/(nLabels-1));
  133.   end; 
  134. end;
  135.  
  136.  
  137. procedure DoColorScaleDemo;
  138. var
  139.   PicWidth,PicHeight,hloc,vloc,ScaleWidth,ScaleHeight:integer;
  140. begin
  141.   GetPicSize(PicWidth,PicHeight);
  142.   width:=0.1*PicWidth;
  143.   if width>40 then width:=40;
  144.   height:=0.9*PicHeight;
  145.   hloc:=0.05*PicHeight;
  146.   vloc:=hloc;
  147.   SetPalette('Spectrum');
  148.   MakeRoi(hloc,vloc,width,height);
  149.   DrawColorScale;
  150.   wait(2);
  151.   SetPalette('Grayscale');
  152. end;
  153.  
  154.  
  155. procedure DemoFilters;
  156. var
  157.   hloc,vloc,RoiWidth,RoiHeight,PicWidth,PicHeight:integer;
  158. begin
  159.   MakeBlocks(3);
  160.   RestoreRoi;
  161.   GetRoi(hloc,vloc,RoiWidth,RoiHeight);
  162.   GetPicSize(PicWidth,PicHeight);
  163.   hloc:=0; vloc:=0;
  164.   AdvanceRoi;
  165.   SetOption; Sharpen;
  166.   AdvanceRoi;
  167.   Shadow;
  168.   AdvanceRoi;
  169.   TraceEdges;
  170.   AdvanceRoi;
  171.   SetOption; Smooth;
  172.   TraceEdges;
  173.   Skeletonize;
  174.   AdvanceRoi;
  175.   Dither;
  176.   AdvanceRoi;
  177.   Invert;
  178.   AdvanceRoi;
  179.   FlipVertical;
  180.   AdvanceRoi;
  181.   FlipHorizontal;
  182. end;
  183.  
  184.  
  185. procedure MakeGrayLevelGrid;
  186. var
  187.   i,hloc,vloc,PicWidth,PicHeight:integer;
  188.   RoiWidth,RoiHeight,GrayLevel,increment:integer;
  189.   scale:real;
  190. begin
  191.   n:=5;
  192.   GetPicSize(PicWidth,PicHeight);
  193.   hloc:=0;
  194.   vloc:=0;
  195.   RoiWidth:=PicWidth div n;
  196.   RoiHeight:=PicHeight div n;
  197.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  198.   GrayLevel:=255;
  199.   increment:=round(256/(n*n));
  200.   SetLineWidth(1);
  201.   for i:=1 to n*n do begin
  202.     SetForeground(GrayLevel);
  203.     fill;
  204.     SetForeground(0);
  205.     DrawBoundary;
  206.     GrayLevel:=GrayLevel-increment;
  207.     if GrayLevel<0 then GrayLevel:=0;
  208.     AdvanceRoi;
  209.   end;
  210.   KillRoi;
  211. end;
  212.  
  213.  
  214. macro 'Demo Macro [D]'
  215. {
  216. This macro demonstrate many of the features available in Image's macro
  217. language. It assumes the Image at least as large as`256x256 has been opened.
  218. }
  219. var
  220.   i:integer;
  221.   width,height,n,W,H:integer;
  222.   scale:real;
  223.   NoImage:boolean;
  224. begin
  225.   NoImage:=nPics<>1;
  226.   if not NoImage then GetPicSize(width,height);
  227.   if NoImage or (width<256) or (height<256) then begin
  228.     PutMessage('This macro needs a single image at least 256 pixels wide and 256 pixels high  to operate on.');
  229.     Exit;
  230.   end;
  231.  
  232.   SaveState;
  233.   DemoFilters;
  234.   wait(2);
  235.  
  236.   RevertToSaved;
  237.   MakeGrayLevelGrid;
  238.   wait(1);
  239.  
  240.   RevertToSaved;
  241.   DrawGrayLevelScale(12);
  242.   wait(1);
  243.  
  244.   RevertToSaved;
  245.   DoColorScaleDemo;
  246.  
  247.   DoTextDemo;
  248.  
  249.  
  250.   RevertToSaved;
  251.   SetScaling('Nearest Neighbor; Same Window');
  252.   for i:= 1 to 4 do begin
  253.     ScaleAndRotate(1.5,1.5,0);
  254.     wait(.5);
  255.   end;
  256.  
  257.   RevertToSaved;
  258.   for i:=1 to 6 do begin
  259.     ScaleAndRotate(0.6,0.6,0);
  260.     wait(.5);
  261.     RestoreRoi;
  262.   end;
  263.  
  264.   RevertToSaved;
  265.   wait(.5);
  266.   ScaleAndRotate(.333,1,0);
  267.   wait(1);
  268.   Undo;
  269.   ScaleAndRotate(1,.333,0);
  270.   wait(1);
  271.  
  272.   Undo;
  273.   FlipVertical;
  274.   wait(.5);
  275.   Undo;
  276.   FlipHorizontal;
  277.   wait(.5);
  278.   Undo;
  279.   RotateRight(true);
  280.   RotateLeft(true);
  281.  
  282.   Shadow;
  283.   Wait(1);
  284.  
  285.   Undo;
  286.   Duplicate('Temp');
  287.   Smooth;
  288.   for i:=1 to 3 do begin SetOption; Sharpen end;
  289.   wait(.5);
  290.   Dispose;
  291.   SelectPic(1);
  292.   Dither;
  293.   wait(.5);
  294.  
  295.   Undo;
  296.   AddConstant(100);
  297.   Wait(1);
  298.   Undo;
  299.   AddConstant(-100);
  300.   Wait(1);
  301.   EnhanceContrast;
  302.   Wait(.5);
  303.   Undo;
  304.   EqualizeHistogram;
  305.   Wait(.5);
  306.   ResetGraymap;
  307.   ShowHistogram;
  308.  
  309.   Smooth;
  310.   TraceEdges;
  311.   wait(.5);
  312.   Erode;
  313.   Dilate;
  314.   Outline;
  315.   Undo;
  316.   Skeletonize;
  317.   Wait(1);
  318.   for i:= 1 to 12 do TraceEdges;
  319.   RestoreState;
  320. end;
  321.  
  322.  
  323. macro 'Make Wallpaper… [M]'
  324. var
  325.   width,height,n:integer;
  326. begin
  327.   GetPicSize(width,height);
  328.   if (width=0) then begin
  329.     PutMessage('This macro needs an image to operate on.');
  330.     Exit;
  331.   end;
  332.   n:=trunc(GetNumber('Replication factor:',8));
  333.   SaveState;
  334.   MakeBlocks(n);
  335.   RestoreState;
  336. end;
  337.  
  338.  
  339.  
  340.